{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit L05_modFlotteTracking;

interface

uses Classes, modClasses, L01_modPlayerUtils, modFlotteTracking, modBaseType;


const
   CNT_ERREUR_ENVOI_DE_FLOTTE = -9874;


type

     TPlayerFlotteTracking = class(TPlayerUtils)
     private
        //
        // Tracking de flotte
        //

        FFlotteTracking: TCollectionOwnFlotteTracking;



        // Fait retourner les flottes si nécessaire
        procedure MakeFlotteReturnIfNeed;


        procedure ClearOwn(bDelFichierSave: boolean);

     public
        // accès aux flottes
        property FlotteTracking: TCollectionOwnFlotteTracking read FFlotteTracking;


        // Envoi une flotte et programme son retour
        function ProceedEnvoiDeFlotteAndRetour(Infos: PFlotteEnvoiData; ClickSurRetourDans: int64; bReDLFlotte1IfEchec: boolean = false): integer;


        // Surcharge pour pouvoir identifier les flottes
        function RetreiveFlotte1Page(bSansParsing: boolean = false): integer; override;


        // pour pouvoir faire retourner les flottes quand nécessaire
        procedure OnTimer; override;


        procedure Clear(bDelFichierSave: boolean); override;


        procedure FlotteTrackingDebug;

        procedure ShowInternal; override;

        // Constructeur / Destructeur
        constructor Create;
        destructor Destroy; override;
     end;

implementation

uses ESBDates, SysUtils, sFonctionsChaines, modApercuMsg;

procedure TPlayerFlotteTracking.FlotteTrackingDebug;
var i: integer;
    pe: POwnFlotteTracking;
    CurrDate: int64;
begin


    if FlotteTracking.Count > 0 then begin
       CurrDate := DateTimeToUnix(Now);

       DoDebug('###########################');

       for i := 0 to FlotteTracking.Count - 1 do begin
           pe := FlotteTracking.Items[i];


           DoDebug('Index: ' + IntToStr(i) + ' ~  uid: DateImpact= ' + IntToStr(pe.uid.DateDepart) + '  - Location= ' + IntToStr(pe.uid.Location));

           DoDebug('Depart: ' + mbtPlanetLocationToStr(pe.Depart) + ' -> Arrivée: ' + mbtPlanetLocationToStr(pe.Arrivee));
           DoDebug('Direction: ' + mamDirectionToStr(pe.Direction));


           DoDebug('Nombre: ' + IntToStr(pe.Nombre) + ' - Vaisseaux: ' + pe.Vaisseaux);


           //Status('SondageAvantImpact: ' + IntToStr(pe.SondageAvantImpact));
           //Status('SondageDateToDo: '    + IntToStr(pe.SondageDateToDo));
           //Status('Evacuation: State= ' + IntToStr(pe.EvacuationState) + ' - Flags: ' + IntToStr(pe.EvacuationFlags) + '  -  AlerteAttIndex: ' + IntToStr(pe.EvacuationAlerteAttIndex));



           DoDebug('ArriveeDateServeur: ' + IntToStr(pe.ArriveeDateServeur) + ' - Local: ' + IntToStr(pe.ArriveeDateLocal) + ' dans ' + iif(pe.ArriveeDateLocal - CurrDate > 0, ESBDGetDureeStrings(pe.ArriveeDateLocal - CurrDate, true), 'déjà arrivée'));


           DoDebug('DateToMakeReturn: ' + IntToStr(pe.DateToMakeReturn));


           DoDebug('FlotteExistePlus: ' + IntToStr(iif(pe.FlotteExistePlus, 1, 0)) + ' - DateNexistePlus: ' + IntToStr(pe.FlotteDateNexistePlus) + ' - depuis ' + iif(pe.FlotteDateNexistePlus > 100, ESBDGetDureeStrings(CurrDate - pe.FlotteDateNexistePlus, true), 'existe encore'));


           DoDebug('###########################');
       end;

    end else begin
        DoDebug('Pas de flotte mémorisée');
    end;

end;

procedure TPlayerFlotteTracking.ShowInternal;
begin

        inherited ShowInternal;
        
        DoDebug('@@@@@ Flotte tracking @@@@@');

        DoDebugInt('.Count', FFlotteTracking.Count);
        
end;


function TPlayerFlotteTracking.ProceedEnvoiDeFlotteAndRetour(Infos: PFlotteEnvoiData; ClickSurRetourDans: int64; bReDLFlotte1IfEchec: boolean = false): integer;
label lblRetryFlotte1, lblEchec, lblFinal;
var LastFlotte: POwnFlotteTracking;
    resEnvoi: TFlotteEnvoiRes;

    iRedo, r: integer;
begin

   // on part du principe que les vaisseaux sont sélectionnés, etc
   // et que par conséquent que la tracking de flotte est à jour
   // puisqu'il a du être téléchargé il y a moins de 3 secondes

   Result := 0;


   resEnvoi := ProceedEnvoiDeFlotte(Infos);


   if resEnvoi = ferSuccess then begin
      // l'envoi a réussi, on programme le retour
      // pour cela, on doit re télécharger la liste de nos flottes

      iRedo := 0;

lblRetryFlotte1:

      if ClickSurRetourDans = 0 then begin
         // pas de retour de flotte
         DoDebug('ProceedEnvoiDeFlotteAndRetour - Pas de retour de flotte activé (valeur = 0)');
         Result := 1;
         exit;

         
      end else if ClickSurRetourDans < 0 then begin
         DoDebug('ProceedEnvoiDeFlotteAndRetour - Pas de retour de flotte activé (valeur < 0)');
         Result := 1;
         exit;
      end;



      if RetreiveFlotte1Page > 0 then begin
         // le téléchargement a réussi

         LastFlotte := FlotteTracking.LastFlotteAdded; 

         if LastFlotte <> nil then begin
            // ok, on a bien retrouvé la flotte
            // dernière vérification

            // la cible peut être une lune
            // ou le départ
            // s'assure que les coordonnées sont en coordonnées "normale"
            // en utilisant la fonction CompareLocationMoonAutoAjust au lieu de CompareLocation
            

            if CompareLocationMoonAutoAjust(LastFlotte.Arrivee, Infos.Cible) then begin
               // c'est bien la même
               // on programme le retour
               LastFlotte.DateToMakeReturn := DateTimeToUnix(Now) + ClickSurRetourDans;

               if LastFlotte.DateToMakeReturn > LastFlotte.ArriveeDateLocal then begin
                  DoDebug('ProceedEnvoiDeFlotteAndRetour - Ajustement du retour car supérieur à l''heure arrivée (ArriveeLocal - X)');
                  LastFlotte.DateToMakeReturn := LastFlotte.ArriveeDateLocal - 10;
               end;

               DoDebug('ProceedEnvoiDeFlotteAndRetour - La flotte sera rappelée à: ' + DateTimeToStr(UnixToDateTime(LastFlotte.DateToMakeReturn)));
               Result := 1;

            end else begin
               // erreur fatale...
               DoDebug('ProceedEnvoiDeFlotteAndRetour - Echec FATALE, Flotte trouvée mais coordonnées invalide... Impossible de programmer le retour');
               Result := -1;
            end;

         end else begin
             DoDebug('ProceedEnvoiDeFlotteAndRetour - Erreur, la flotte n''a pas été trouvé... Impossible de programmer le retour');
             Result := -2;
         end;

      end else begin
         DoDebug('ProceedEnvoiDeFlotteAndRetour - Impossible de télécharge la page de flotte... Impossible de programmer le retour');
         Result := -3;

         if Result = 0 then begin
            DoSleep(4000);
            Inc(iRedo);

            if iRedo > 5 then begin
               DoDebug('ProceedEnvoiDeFlotteAndRetour - Impossible de programmer le retour');
               goto lblFinal;
            end;

            DoDebug('ProceedEnvoiDeFlotteAndRetour - Réessaye...');
            goto lblRetryFlotte1;
         end;
      end;


   end else if resEnvoi = ferShouldRetry then begin
      // cela arrive quand la page finale est trop petite
      DoDebug('ProceedEnvoiDeFlotteAndRetour - Echec d''envoi, réessaye...');

      // mais il faut repasser par la page1 avant...
      // cependant on va perdre les vaisseaux sélectionner
      // donc on triche un peu et on ne télécharge que la page sans
      // refaire le parsing
      r := RetreiveFlotte1Page(true);

      if r < 1 then begin
         // erreur
         DoDebug('ProceedEnvoiDeFlotteAndRetour - Echec de telechargement de la page 1, réessaye une dernière fois...');

         r := RetreiveFlotte1Page(true);
         if r < 1 then begin
            DoDebug('ProceedEnvoiDeFlotteAndRetour - Echec à nouveau (page flotte1)');
            goto lblEchec;
         end;
      end;

      resEnvoi := ProceedEnvoiDeFlotte(Infos);


      if resEnvoi = ferSuccess then begin
         goto lblRetryFlotte1;
         
      end else begin
         DoDebug('ProceedEnvoiDeFlotteAndRetour - Echec d''envoi, réessaye une dernière fois...');

         if RetreiveFlotte1Page(true) > 0 then begin
            resEnvoi := ProceedEnvoiDeFlotte(Infos);

            if resEnvoi = ferSuccess then begin
               goto lblRetryFlotte1;
            end;
         end;

         goto lblEchec;
      end;


   end else begin
      // l'envoi de flotte a échoué
lblEchec:
      DoDebug('ProceedEnvoiDeFlotteAndRetour - L''envoi de la flotte a échoué');
      Result := CNT_ERREUR_ENVOI_DE_FLOTTE;

   end;

lblFinal:
   if (Result < 1) and bReDLFlotte1IfEchec then begin
      // retélécharge la page 1
      r := RetreiveFlotte1Page(true);

      if r < 1 then begin
         DoDebug('ProceedEnvoiDeFlotteAndRetour - Echec de retéléchargement de la page flotte1...');
         r := RetreiveFlotte1Page(true);
      end;
   end;

end;


procedure TPlayerFlotteTracking.OnTimer;
begin

    inherited OnTimer;

    MakeFlotteReturnIfNeed;

end;


function TPlayerFlotteTracking.RetreiveFlotte1Page(bSansParsing: boolean = false): integer;
var iFlotteLibre: integer;
begin

    Result := inherited RetreiveFlotte1Page(bSansParsing);


    if (Result > 0) and (bSansParsing = false) then begin
       // met à jour les flottes
       FFlotteTracking.DiffHeureLocaleHeureServeur := DifferenceHeureLocaleHeureServeur;
       FFlotteTracking.RefreshFromFlottePage(cFlotteVaisseaux.FlotteList);


       FFlotteTracking.LastDateUpdated := DateTimeToUnix(Now);

    end else begin
       // Erreur de dl... ou bSansParsing = true
       
    end;


    
end;



procedure TPlayerFlotteTracking.MakeFlotteReturnIfNeed;
var i: integer;
    pe: POwnFlotteTracking;

begin

    if FFlotteTracking.Count = 0 then begin
       exit;
    end;

    LastCurrDate := DateTimeToUnix(Now);

    for i := 0 to FFlotteTracking.Count - 1 do begin
        pe := FFlotteTracking.Items[i];

        if pe.Direction = odAller then begin
           // sens aller, on peut donc la faire retourner si il le faut
           if pe.DateToMakeReturn > 100 then begin
              // il faut la faire retourner à un moment donné

              if pe.DateToMakeReturn < pe.ArriveeDateLocal then begin
                 // la date de retour a lieu avant la date d'impact
                 // on vérifie si on a dépassé la date de retour

                 if LastCurrDate >= pe.DateToMakeReturn then begin
                    // on a atteint ou dépassé la date de retour
                    // on fait un retour de flotte

                    if ProceedReturnFlotte(@pe.uid) > 0 then begin
                       DoDebug('FlotteTracking - Retour de flotte effectué');

                       // indique que cela a été effectué
                       pe.DateToMakeReturn := -7;
                    end else begin
                       DoDebug('FlotteTracking - Echec de retour de flotte');

                       pe.DateToMakeReturn := -1;
                    end;


                 end; // le retour doit être effectué maintenant
              end; // date de retour avant l'impact
           end;  // date de retour positive
        end; // sens aller
    end; // boucle

end;



destructor TPlayerFlotteTracking.Destroy;
begin
    FFlotteTracking.Free;

   inherited Destroy;
end;

constructor TPlayerFlotteTracking.Create;
begin
    inherited Create;

    FFlotteTracking := TCollectionOwnFlotteTracking.Create;

    ClearOwn(true);
end;

procedure TPlayerFlotteTracking.ClearOwn(bDelFichierSave: boolean);
begin
    if bDelFichierSave then begin
       FFlotteTracking.Clear;

    end;
end;

procedure TPlayerFlotteTracking.Clear(bDelFichierSave: boolean);
begin
     inherited Clear(bDelFichierSave);


    // clear est appellé dans le constructeur
    // et comme on l'a overridé, le clear de la classe mère
    // va appeller le clear de la classe fille, dont l'objet
    // FFlotteTracking n'existe pas encore
    if FFlotteTracking <> nil then begin
       ClearOwn(bDelFichierSave);
    end;

end;

end.
